home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Plurals / Modules / cmlisp-ll.em next >
Lisp/Scheme  |  1992-03-06  |  1KB  |  48 lines
  1. (defmodule cmlisp-ll (standard0) ()
  2.  
  3.   (setq Context 0)
  4.  
  5.   (defun the-context (v) Context)
  6.  
  7.   ((setter setter) the-context (lambda (v) (setq Context v)))
  8.  
  9.   (setq last-function-name-internal ())
  10.  
  11.   (defun last-function-name () last-function-name-internal)
  12.  
  13.   (setq last-function-arglist-internal ())
  14.  
  15.   (defun last-function-arglist () last-function-arglist-internal)
  16.  
  17.   (defmacro p-1-fn (fn other-arg)
  18.     (let ((f-name (gensym)))
  19.       (setq last-function-name-internal f-name)
  20.       (setq last-function-arglist-internal '(a))
  21.       `(defun ,f-name (a)
  22.        (,fn ,@(append (list Context `a)
  23.               (if other-arg (list other-arg) ()))))))
  24.  
  25.   (defmacro p-2-fn (fn other-arg)
  26.     (let ((f-name (gensym)))
  27.       (setq last-function-name-internal f-name)
  28.       (setq last-function-arglist-internal '(a b))
  29.       `(defun ,f-name (a b)
  30.      (,fn ,@(append (list Context `a `b)
  31.             (if other-arg (list other-arg) ()))))))
  32.  
  33.   (defmacro p-3-fn (fn other-arg)
  34.     (let ((f-name (gensym)))
  35.       (setq last-function-name-internal f-name)
  36.       (setq last-function-arglist-internal '(a b))
  37.       `(defun ,f-name (a b c)
  38.      (,fn ,@(append (list Context `a `b `c)
  39.             (if other-arg (list other-arg) ()))))))
  40.  
  41.   (export p-1-fn p-2-fn p-3-fn the-context last-function-name
  42.       last-function-arglist)
  43. )
  44.  
  45.  
  46.  
  47.  
  48.